home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / VISUALBA / BLTQ12.ZIP / BB_CIN10.BAS < prev    next >
BASIC Source File  |  1993-01-04  |  14KB  |  491 lines
  1.  
  2. DEFINT A-Z
  3.  
  4. REM $INCLUDE: 'BULLET.BI'
  5. 'bb_cin10.bas 31-May-92 chh
  6. '--example using 8-char key, dups and
  7. '--a second index of LONG INT (on SSN field), dups allowed for this example
  8.  
  9. 'this example shows the transaction-based feature of InsertXB--it purposely
  10. 'adds a record, inserts the first key, and then often times will duplicate
  11. 'an existing SSN key, thus causing the first key and the data record to be
  12. 'removed. The DUPS cnt value displayed is the number of Inserts that were
  13. 'attempted that resulted in a duplicated key being created for the SSN index
  14. 'file.  The DUPS cnt + Records: + IX1 keys: (or + IX2 keys:) should
  15. 'equal the number of records to insert requested (it does). If transaction
  16. 'processing were not available, you would have to go in manually and delete
  17. 'the keys previously added for this record, then remove the record itself
  18. '(physically remove it which is not a function of dBASE). Basically, it'd be
  19. 'a pain if it were even possible at all. With transaction-based routines such
  20. 'as InsertXB, all this is taken care of by BULLET automatically.
  21.  
  22. 'this code is for a simplistic database
  23. 'it uses a single DBF (true DBF-compat) and two related indexes
  24. 'the first index is on the first 5 chars of last name + first char first name
  25. 'second index is on the SSN, since it's a valid LONG INT we use that key type
  26.  
  27. 'C>bc bb_cin10 /o;
  28. 'C>link bb_cin10,,nul,bullet;
  29.  
  30. UseDir$ = ".\"                  'all files use this directory except
  31.                                 'the reindex work file which uses the
  32.                                 'SET TMP= directory or the current directory
  33. CLS
  34. PRINT "BB_CIN10.BAS - 8-CHAR (DUPS) and LONG INT (UNIQUE), InsertXB example"
  35. PRINT "--maintains *2* index files automatically, using NLS sorting."
  36. PRINT ">> USING DIRECTORY "; UseDir$
  37. PRINT
  38.  
  39. TYPE TestRecTYPE
  40. Tag AS STRING * 1
  41. FirstName AS STRING * 15        'a DBF C fieldtype
  42. LastName AS STRING * 19         'C
  43. SSN AS STRING * 9               'N (use C instead to use SUBSTR() on it)
  44. BDate AS STRING * 8             'D
  45. DeptNo AS STRING * 3            'C
  46. Salary AS STRING * 9            'N
  47. END TYPE '64                    'DBF III+ limit is 4000 bytes/128 fields
  48.                                 
  49. DIM DFP AS DOSFilePack
  50. DIM MP AS MemoryPack
  51. DIM IP AS InitPack
  52. DIM EP AS ExitPack
  53. DIM CDP AS CreateDataPack
  54. DIM CKP AS CreateKeyPack
  55. DIM OP AS OpenPack
  56. DIM AP(1 TO 2) AS AccessPack    '2 since we're maintaining 2 index files
  57. DIM SDP AS StatDataPack
  58. DIM SKP AS StatKeyPack
  59.  
  60. DIM FieldList(1 TO 6) AS FieldDescTYPE
  61. DIM TestRec AS TestRecTYPE
  62. DIM ZSTR AS STRING * 1
  63. DIM NameDAT AS STRING * 80      'DBF data file
  64. DIM NameIX1 AS STRING * 80      'first index file
  65. DIM NameIX2 AS STRING * 80      'second index file
  66. DIM KX1 AS STRING * 136         'key expression for first index file
  67. DIM KX2 AS STRING * 136         'key expression for second index file
  68. DIM KeyBuffer AS STRING * 64
  69.  
  70. DIM First$(1 TO 26)
  71. DIM Last$(1 TO 26)
  72. GOSUB FillNamesIn
  73.  
  74. ZSTR = CHR$(0)
  75. NameDAT = UseDir$ + "CHARTEST.DBF" + ZSTR
  76. NameIX1 = UseDir$ + "CHARTEST.IX1" + ZSTR
  77. NameIX2 = UseDir$ + "CHARTEST.IX2" + ZSTR
  78.  
  79. FieldList(1).FieldName = "FIRSTNAME" + ZSTR
  80. FieldList(1).FieldType = "C"
  81. FieldList(1).FieldLength = CHR$(15)
  82. FieldList(1).FieldDC = CHR$(0)
  83. FieldList(2).FieldName = "LASTNAME" + ZSTR + ZSTR
  84. FieldList(2).FieldType = "C"
  85. FieldList(2).FieldLength = CHR$(19)
  86. FieldList(2).FieldDC = CHR$(0)
  87. FieldList(3).FieldName = "SSN" + STRING$(7, 0)
  88. FieldList(3).FieldType = "N"
  89. FieldList(3).FieldLength = CHR$(9)
  90. FieldList(3).FieldDC = CHR$(0)
  91. FieldList(4).FieldName = "BDATE" + STRING$(5, 0)
  92. FieldList(4).FieldType = "D"
  93. FieldList(4).FieldLength = CHR$(8)
  94. FieldList(4).FieldDC = CHR$(0)
  95. FieldList(5).FieldName = "DEPTNO" + STRING$(4, 0)
  96. FieldList(5).FieldType = "C"
  97. FieldList(5).FieldLength = CHR$(3)
  98. FieldList(5).FieldDC = CHR$(0)
  99. FieldList(6).FieldName = "SALARY" + STRING$(4, 0)
  100. FieldList(6).FieldType = "N"
  101. FieldList(6).FieldLength = CHR$(9)
  102. FieldList(6).FieldDC = CHR$(2)
  103.  
  104. level = 100
  105. MP.Func = MemoryXB
  106. stat = BULLET(MP)
  107. IF MP.Memory < 140000 THEN
  108.     QBheap& = SETMEM(-150000)       'hog wild, 64K would do okay
  109.     MP.Func = MemoryXB
  110.     stat = BULLET(MP)
  111.     IF MP.Memory < 140000 THEN stat = 8: GOTO Abend
  112. END IF
  113.  
  114. level = 110
  115. IP.Func = InitXB
  116. IP.JFTmode = 0
  117. stat = BULLET(IP)
  118. IF stat THEN GOTO Abend
  119.  
  120. level = 120
  121. EP.Func = AtExitXB
  122. stat = BULLET(EP)
  123.  
  124. level = 130
  125. DFP.Func = DeleteFileDOS
  126. DFP.FilenamePtrOff = VARPTR(NameDAT)
  127. DFP.FilenamePtrSeg = VARSEG(NameDAT)
  128. stat = BULLET(DFP)
  129. DFP.FilenamePtrOff = VARPTR(NameIX1)
  130. DFP.FilenamePtrSeg = VARSEG(NameIX1)
  131. stat = BULLET(DFP)
  132. DFP.FilenamePtrOff = VARPTR(NameIX2)
  133. DFP.FilenamePtrSeg = VARSEG(NameIX2)
  134. stat = BULLET(DFP)
  135.  
  136. level = 1000
  137. CDP.Func = CreateDXB
  138. CDP.FilenamePtrOff = VARPTR(NameDAT)
  139. CDP.FilenamePtrSeg = VARSEG(NameDAT)
  140. CDP.NoFields = 6
  141. CDP.FieldListPtrOff = VARPTR(FieldList(1))
  142. CDP.FieldListPtrSeg = VARSEG(FieldList(1))
  143. CDP.FileID = 3
  144. stat = BULLET(CDP)
  145. IF stat THEN GOTO Abend
  146.  
  147. level = 1010
  148. OP.Func = OpenDXB
  149. OP.FilenamePtrOff = VARPTR(NameDAT)
  150. OP.FilenamePtrSeg = VARSEG(NameDAT)
  151. OP.ASmode = ReadWrite + DenyNone
  152. stat = BULLET(OP)
  153. IF stat THEN GOTO Abend
  154. HandDAT = OP.Handle
  155.  
  156. level = 1100
  157. KX1 = "SUBSTR(LASTNAME,1,5)+SUBSTR(FIRSTNAME,1,1)"
  158. CKP.Func = CreateKXB
  159. CKP.FilenamePtrOff = VARPTR(NameIX1)
  160. CKP.FilenamePtrSeg = VARSEG(NameIX1)
  161. CKP.KeyExpPtrOff = VARPTR(KX1)
  162. CKP.KeyExpPtrSeg = VARSEG(KX1)
  163. CKP.XBlink = HandDAT
  164. CKP.KeyFlags = cCHAR
  165. CKP.CodePageID = -1
  166. CKP.CountryCode = -1
  167. CKP.CollatePtrOff = 0
  168. CKP.CollatePtrSeg = 0
  169. stat = BULLET(CKP)
  170. IF stat THEN GOTO Abend
  171.  
  172. level = 1102
  173. KX2 = "SSN"
  174. CKP.Func = CreateKXB
  175. CKP.FilenamePtrOff = VARPTR(NameIX2)
  176. CKP.FilenamePtrSeg = VARSEG(NameIX2)
  177. CKP.KeyExpPtrOff = VARPTR(KX2)
  178. CKP.KeyExpPtrSeg = VARSEG(KX2)
  179. CKP.XBlink = HandDAT
  180. CKP.KeyFlags = cLONG + cUNIQUE          'test transaction ability by forcing
  181. CKP.CodePageID = -1                     'duplicate SSN numbers
  182. CKP.CountryCode = -1                    'number of final records and keys in
  183. CKP.CollatePtrOff = 0                   'each index file should be number of
  184. CKP.CollatePtrSeg = 0                   'Inserts requested - DUPS cnt
  185. stat = BULLET(CKP)
  186. IF stat THEN GOTO Abend
  187.  
  188. level = 1110
  189. OP.Func = OpenKXB
  190. OP.FilenamePtrOff = VARPTR(NameIX1)
  191. OP.FilenamePtrSeg = VARSEG(NameIX1)
  192. OP.ASmode = ReadWrite + DenyNone
  193. OP.xbHandle = HandDAT
  194. stat = BULLET(OP)
  195. IF stat THEN GOTO Abend
  196. HandIX1 = OP.Handle
  197.  
  198. level = 1112
  199. OP.Func = OpenKXB
  200. OP.FilenamePtrOff = VARPTR(NameIX2)
  201. OP.FilenamePtrSeg = VARSEG(NameIX2)
  202. OP.ASmode = ReadWrite + DenyNone
  203. OP.xbHandle = HandDAT
  204. stat = BULLET(OP)
  205. IF stat THEN GOTO Abend
  206. HandIX2 = OP.Handle
  207.  
  208. AP(1).Func = InsertXB
  209. AP(1).Handle = HandIX1
  210. AP(1).RecPtrOff = VARPTR(TestRec)
  211. AP(1).RecPtrSeg = VARSEG(TestRec)
  212. AP(1).KeyPtrOff = VARPTR(KeyBuffer)
  213. AP(1).KeyPtrSeg = VARSEG(KeyBuffer)
  214. AP(1).NextPtrOff = VARPTR(AP(2))
  215. AP(1).NextPtrSeg = VARSEG(AP(2))
  216. AP(2).Func = InsertXB
  217. AP(2).Handle = HandIX2
  218. AP(2).RecPtrOff = VARPTR(TestRec)
  219. AP(2).RecPtrSeg = VARSEG(TestRec)
  220. AP(2).KeyPtrOff = VARPTR(KeyBuffer)
  221. AP(2).KeyPtrSeg = VARSEG(KeyBuffer)
  222. AP(2).NextPtrOff = 0
  223. AP(2).NextPtrSeg = 0
  224.  
  225. level = 1200
  226. 'keep Recs to insert below 1000 since there SSN values generated in this
  227. 'example range from 100000000 to 1000000999
  228.  
  229. INPUT "(suggest no more than 1000) Recs to insert:"; Recs2Add&
  230. PRINT "Inserting record:";
  231. herecol = POS(0)
  232.  
  233. 'these are not key values so just make them constant for this example
  234.  
  235. TestRec.Tag = " "
  236. TestRec.BDate = "19331122"   'yes, everyone is the same age
  237. TestRec.DeptNo = "001"       'yes, same dept too
  238. TestRec.Salary = "125000.77" 'and even the same salary
  239.  
  240. 'RANDOMIZE TIMER
  241. GOSUB StartTimer
  242. FOR Recs& = 1 TO Recs2Add&
  243.    RandLN = 1 + (25 * RND)
  244.    RandFN = 1 + (25 * RND)
  245.    TestRec.FirstName = First$(RandLN)
  246.    TestRec.LastName = Last$(RandFN)
  247.    TestRec.SSN = LTRIM$(STR$(100000000 + (999 * RND)))  'make it easy to DUP
  248.    stat = 0
  249.    LOCATE , herecol
  250.    PRINT Recs&;
  251.    sidx = BULLET(AP(1))
  252.    IF sidx = 0 AND AP(1).stat THEN
  253.       'error on data record add portion